Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/forms/qkform/default.qft

Visual Basic Form | 1995-01-26 | 8.8 KB | 339 lines

VERSION 2.00
Begin Form frm
   BackColor       =   &H00C0C0C0&
   Caption         =   "Form1"
   ClientHeight    =   5820
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   7365
   Height          =   6225
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   5820
   ScaleWidth      =   7365
   Top             =   1140
   Width           =   7485
   Begin TextBox Text1
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   285
      Left            =   3120
      TabIndex        =   6
      Top             =   1680
      Width           =   1935
   End
   Begin MaskEdBox MaskedEdit1
      Height          =   375
      Left            =   3000
      PromptChar      =   "_"
      TabIndex        =   5
      Top             =   3360
      Width           =   2055
   End
   Begin VScrollBar VScroll1
      Height          =   1215
      Left            =   3960
      TabIndex        =   4
      Top             =   240
      Width           =   255
   End
   Begin HScrollBar HScroll1
      Height          =   255
      Left            =   1080
      TabIndex        =   3
      Top             =   720
      Width           =   2295
   End
   Begin CommandButton btn
      Caption         =   "Command1"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   1680
      Width           =   1215
   End
   Begin CheckBox chk
      BackColor       =   &H00C0C0C0&
      Caption         =   "Check1"
      Height          =   255
      Left            =   360
      TabIndex        =   1
      Top             =   2280
      Width           =   2055
   End
   Begin Data Data1
      BackColor       =   &H00808080&
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   270
      Left            =   2520
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   ""
      Top             =   2280
      Width           =   3135
   End
   Begin Label lbl
      BackColor       =   &H8000000F&
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      Height          =   255
      Left            =   1680
      TabIndex        =   0
      Top             =   1680
      Width           =   1095
   End
Dim GotFocusValue As String
Dim ModAppend As Integer
Dim ModEdit As Integer
Dim NoMove As Integer
Dim TotRec As Long
Dim CurrRec As Long
Dim JustUsedFind As Integer
Dim JustSetRec As Integer
Dim BookMrk
DO_FOR TextBox
Sub %CONTROLNAME%_GotFocus ()
'///// Select text when got focus
    SelectText Me.%CONTROLNAME%
    GotFocusValue = %CONTROLNAME%
End Sub
Sub %CONTROLNAME%_KeyPress (KeyAscii As Integer)
Select Case KeyAscii
    Case Is = 27    '///// Escape Key was pressed - Undo changes in current field
    KeyAscii = 0
    %CONTROLNAME% = GotFocusValue
    Case Is = 13    '///// Go to next control in tab order
    KeyAscii = 0
    SendKeys "{Tab}"
    Case Else 'If not in edit mode or add mode then begin mode edit
    If ModAppend = 0 and ModEdit = 0 Then EditRecord
End Select
End Sub
Sub %CONTROLNAME%_KeyDown (KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case  40    '\\\\\ Arrow Down - '///// Go to next control in tab order
    SendKeys "{Tab}"
    Case  38    '\\\\\ Arrow Up - '///// Go to previous control in tab order
    SendKeys "+({Tab})"
End Select
End Sub
_LOOP_
Sub BeginEditOrAppend ()
    btnNew.Enabled = False
    btnDelete.Enabled = False
    Data1.Enabled = False
    btnSave.Enabled = True
    btnCancel.Enabled = True
End Sub
Sub btnCancel_Click ()
'\\\\\ Cancel changes made in the current record
JustSetRec = 0
If ModAppend = 1 Then
    If Data1.Recordset.RecordCount <> 0 Then
    Data1.Recordset.Bookmark = BookMrk
    UpdateFields
    NoMove = 0
    End If
    SetRecNum
    Select Case Data1.Recordset.RecordCount
    Case Is = 0
        ClearAllFields
    Case Else
        UpdateFields
    End Select
End If
EndEditOrAppend
End Sub
Sub btnDelete_Click ()
Dim Answer
JustSetRec = 0
Select Case Data1.Recordset.RecordCount
    Case Is = 0
    MsgBox ("No record found for deletion.")
    Case Is = 1
    Answer = MsgBox("Delete record", 36, "Delete record ???")
    If Answer = 7 Then 'Answer = No
        Exit Sub
    Else
        Data1.Recordset.Delete
        EndEditOrAppend
        ClearAllFields
        Data1.Caption = "No record"
    End If
    Case Else
    Answer = MsgBox("Delete record", 36, "Delete record ???")
    If Answer = 7 Then 'Answer = No
        Exit Sub
    Else
        CurrRec = CurrRec - 1
        Data1.Recordset.Delete
        If CurrRec = TotRec Then
        CurrRec = CurrRec + 1
        Data1.Recordset.MovePrevious
        Else
        Data1.Recordset.MoveNext
        End If
    End If
End Select
End Sub
Sub btnNew_Click ()
JustSetRec = 0
If Data1.Recordset.RecordCount <> 0 Then
    BookMrk = Data1.Recordset.Bookmark
End If
BeginEditOrAppend
ModAppend = 1
Data1.Recordset.AddNew
ClearAllFields
'\\\\\ Add the next line if the primary key is counter
fieldname
 = Data1.Recordset(0)
End Sub
Sub btnSave_Click ()
JustSetRec = 0
SaveRecord
EndEditOrAppend
btnNew.SetFocus
End Sub
Sub ClearAllFields ()
'\\\\\ Reset all the TextBox to a zero-length string
DO_FOR TextBox
    %CONTROLNAME% = ""
_LOOP_
End Sub
Sub Data1_Reposition ()
If ModAppend <> 1 And NoMove = 0 Then
    UpdateFields
    Dim BookMrk As String
    Dim ds As dynaset
    If JustUsedFind = True Then
    Set ds = Data1.Recordset.Clone()
    BookMrk = Data1.Recordset.Bookmark
    ds.MoveFirst
    CurrRec = 1
    While ds.Bookmark <> BookMrk
        CurrRec = CurrRec + 1
        ds.MoveNext
    Wend
    JustUsedFind = False
    End If
If JustSetRec = 0 Then SetRecNum
End If
End Sub
Sub Data1_Validate (Action As Integer, Save As Integer)
Select Case Action
    Case 1          'First
    CurrRec = 1
    Case 2          'Previous
    If CurrRec = 1 Then Beep
    If CurrRec <> 1 Then CurrRec = CurrRec - 1
    Case 3          'Next
    If CurrRec = TotRec Then Beep
    If CurrRec <> TotRec Then CurrRec = CurrRec + 1
    Case 4          'Last
    CurrRec = TotRec
    Case 5          'AddNew
    Case 6          'Update
    If ModAppend = 1 Then
        NoMove = 0
        TotRec = TotRec + 1
        CurrRec = TotRec
    End If
    Case 7          'Delete
    TotRec = TotRec - 1
    Case 8
    JustUsedFind = True
    Case 9          'BookMark
       'do nothing
    Case 10          'Close
End Select
End Sub
Sub EditRecord ()
On Error GoTo EditRecord_Err
    Data1.Recordset.Edit
    BeginEditOrAppend
    ModEdit = 1
EditRecord_Err:
Select Case Err
    Case Is = 3021
    btnNew_Click
    Exit Sub
End Select
End Sub
Sub EndEditOrAppend ()
    btnNew.Enabled = True
    btnDelete.Enabled = True
    Data1.Enabled = True
    btnSave.Enabled = False
    btnCancel.Enabled = False
    ModAppend = 0
    ModEdit = 0
End Sub
Sub Form_Load ()
screen.MousePointer = 11
Dim DataDyn As dynaset
ModAppend = 0 '\\\\\ Not in Mode Append
NoMove = 0    '\\\\\ NoMove flags is off
CurrRec = 1
Data1.Refresh
Set DataDyn = Data1.Recordset.Clone()
If DataDyn.BOF = False Then
    DataDyn.MoveLast
    TotRec = DataDyn.RecordCount
    TotRec = 0
End If
    DataDyn.Close
    SetRecNum
GoTo LoadEnd
  Exit Sub
LoadEnd:
  screen.MousePointer = 0
End Sub
Sub SaveRecord ()
'\\\\\ Save the current record in the database
DO_FOR TextBox
Data1.Recordset("%FIELDNAME%") = NullToNothing(%CONTROLNAME%)
_LOOP_
If ModAppend = 0 Then '\\\\\ If in Mode Edit
    Data1.Recordset.Update
Else '\\\\\ In Mode Append
    Data1.Recordset.Update
    Data1.Recordset.MoveLast
    UpdateFields
End If
    SetRecNum
End Sub
Sub SetRecNum ()
If Data1.EditMode <> 2 Then
    If Data1.Recordset.BOF = True Then
    Data1.Caption = "First of " & TotRec
    ElseIf Data1.Recordset.EOF = True Then
    Data1.Caption = "First of " & TotRec
    Else
    Data1.Caption = "Record " & CurrRec & " of " & TotRec
    End If
End If
End Sub
Sub UpdateFields ()
'\\\\\ Read the current record and update all fields
If Data1.Recordset.RecordCount > 0 Then
DO_FOR TextBox
%CONTROLNAME% = NullToNothing(Data1.Recordset("%FIELDNAME%"))
_LOOP_
End If
End Sub